home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #1 / Amiga Plus CD - 1997 - No. 01.iso / pd / programmierung / oberonv4 / demos / crazyfiller.mod (.txt) < prev    next >
Oberon Text  |  1996-04-02  |  16KB  |  356 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. InfoElems
  4. Alloc
  5. Syntax10.Scn.Fnt
  6. StampElems
  7. Alloc
  8. 2 Apr 96
  9. "Title": CrazyFiller
  10. "Author": Christoph Steindl (CS)
  11. "Abstract": Implements a new handler for the filler viewers. Filler viewers are dummy viewers which are
  12.     visible if no other viewers are on the screen (as well in the user track as in the system track). Then the 
  13.     filler viewers are painted with Mandlebrot sets. You can zoom into the figures selecting a rectangular 
  14.     area with the left mouse. You can restore the initial figure by pressing the setup button.
  15. "Keywords": filler
  16. "Version": 1.0
  17. "From":  02.02.95 16:26:50
  18. "Until": 
  19. "Changes": selection is restricted so that zoomed area fits into the filler viewer without distortion
  20. "Hints": Use System.Open CrazyFiller.Tool
  21. Syntax10i.Scn.Fnt
  22. FoldElems
  23. Syntax10.Scn.Fnt
  24. redraw
  25. Syntax10.Scn.Fnt
  26. define new zooming area
  27. Syntax10.Scn.Fnt
  28. restore to full size
  29. MODULE CrazyFiller;    
  30.     (* Christoph Steindl (CS) 02.02.95 - 10 Feb 95 *)
  31. IMPORT Display, Viewers, Oberon, In, Out, Input;
  32. CONST 
  33.     ML = 2; MM = 1; MR = 0; (* mouse keys *)
  34.     filler = 1;
  35.     bound = 10;
  36.     CrazyFiller* = POINTER TO CrazyFillerDesc;
  37.     Drawer* = POINTER TO DrawerDesc;
  38.     Region* = POINTER TO RegionDesc;
  39.     DrawerDesc* = RECORD (Oberon.TaskDesc)
  40.         filler: CrazyFiller;
  41.         dx, dy: LONGREAL;
  42.     END;
  43.     CrazyFillerDesc* = RECORD;
  44.         vwr: Viewers.Viewer;
  45.         regions: Region;
  46.         drawer: Drawer;
  47.         xMin, xMax, yMin, yMax: LONGREAL
  48.     END;
  49.     RegionDesc* = RECORD
  50.         x, y, w, h: INTEGER;
  51.         next: Region
  52.     END;
  53.     fillerHandler: Display.Handler;
  54.     userFiller, systemFiller: CrazyFiller;
  55.     maxIter*: INTEGER;
  56.     regsPerCycle*: INTEGER;
  57. PROCEDURE Min(x, y: INTEGER): INTEGER;
  58. BEGIN
  59.     IF x < y THEN RETURN x ELSE RETURN y END
  60. END Min;
  61. PROCEDURE Max(x, y: INTEGER): INTEGER;
  62. BEGIN
  63.     IF x > y THEN RETURN x ELSE RETURN y END
  64. END Max;
  65. PROCEDURE DrawMandelbrodt;
  66.     VAR this: Drawer; p, q, h1, h2, x, y, x0, y0: LONGREAL; filler: CrazyFiller;
  67.         region: Region; k1, k2, k3, k4, k5, i, j, count: INTEGER; allBlack: BOOLEAN;
  68.     PROCEDURE Dot (col, x, y: INTEGER);
  69.     BEGIN
  70.         IF col = maxIter THEN
  71.             Display.ReplConst(Display.white, x, y, 1, 1, Display.replace)
  72.         ELSE
  73.             Display.ReplConst(col MOD 15, x, y, 1, 1, Display.replace)
  74.         END
  75.     END Dot;
  76.     PROCEDURE Eval (i, j: INTEGER; VAR k: INTEGER);
  77.     BEGIN
  78.         k := 0; x := 0; y := 0;
  79.         p := filler.xMin + (i - filler.vwr.X) * this.dx; q := filler.yMin + (j - filler.vwr.Y) * this.dy;
  80.         REPEAT
  81.             h1 := x * x; h2 := y * y;
  82.             x0 := h1 - h2 + p; y0 := 2 * x * y + q;
  83.             x := x0; y := y0; INC(k)
  84.         UNTIL (k >= maxIter) OR (h1 + h2 > bound);
  85.     END Eval;
  86.     PROCEDURE Divide (x, y, w, h: INTEGER; VAR regions: Region);
  87.         VAR xHalf, yHalf: INTEGER; tmp: Region;
  88.     BEGIN
  89.         xHalf := w DIV 2; yHalf := h DIV 2;
  90.         IF xHalf # 0 THEN
  91.             IF yHalf # 0 THEN
  92.                 NEW(tmp); tmp.x := x; tmp.y := y; tmp.w := xHalf; tmp.h := yHalf; 
  93.                 tmp.next := regions; regions := tmp; 
  94.                 NEW(tmp); tmp.x := x + xHalf; tmp.y := y; tmp.w := w - xHalf; tmp.h := yHalf;
  95.                 tmp.next := regions; regions := tmp;
  96.                 NEW(tmp); tmp.x := x; tmp.y := y + yHalf; tmp.w := xHalf; tmp.h := h - yHalf;
  97.                 tmp.next := regions; regions := tmp;
  98.                 NEW(tmp); tmp.x := x + xHalf; tmp.y := y + yHalf; tmp.w := w - xHalf; tmp.h := h - yHalf;
  99.                 tmp.next := regions; regions := tmp;
  100.             ELSE
  101.                 NEW(tmp); tmp.x := x; tmp.y := y; tmp.w := xHalf; tmp.h := 1; 
  102.                 tmp.next := regions; regions := tmp;
  103.                 NEW(tmp); tmp.x := x + xHalf; tmp.y := y; tmp.w := w - xHalf; tmp.h := 1;
  104.                 tmp.next := regions; regions := tmp;
  105.             END
  106.         ELSE
  107.             IF yHalf # 0 THEN
  108.                 NEW(tmp); tmp.x := x; tmp.y := y; tmp.w := 1; tmp.h := yHalf; 
  109.                 tmp.next := regions; regions := tmp;
  110.                 NEW(tmp); tmp.x := x; tmp.y := y + yHalf; tmp.w := 1; tmp.h := h - yHalf;
  111.                 tmp.next := regions; regions := tmp;
  112.             ELSE
  113.                 Eval(x, y, xHalf);
  114.                 Dot(xHalf, x, y)
  115.             END
  116.         END
  117.     END Divide;
  118. BEGIN
  119.     this := Oberon.CurTask(Drawer); filler := this.filler;
  120.     region := filler.regions; filler.regions := filler.regions.next;
  121.     count := regsPerCycle;
  122.     WHILE (count > 0) & (region # NIL) DO
  123.         Eval(region.x, region.y, k1); Eval(region.x + region.w - 1, region.y, k2);
  124.         Eval(region.x, region.y + region.h - 1, k3); Eval(region.x + region.w - 1, region.y + region.h - 1, k4);
  125.         Dot(k1, region.x, region.y); Dot(k2, region.x + region.w - 1, region.y);
  126.         Dot(k3, region.x, region.y + region.h - 1); Dot(k4, region.x + region.w - 1, region.y + region.h - 1);
  127.         allBlack := (k1 = k2) & (k2 = k3) & (k3 = k4);
  128.         FOR i := region.x + 1 TO region.x + region.w - 2 DO
  129.             Eval(i, region.y, k5); Dot(k5, i, region.y); allBlack := allBlack & (k5 = k1);
  130.             Eval(i, region.y + region.h - 1, k5); Dot(k5, i, region.y + region.h - 1); allBlack := allBlack & (k5 = k1)
  131.         END;
  132.         FOR j := region.y + 1 TO region.y + region.h - 2 DO
  133.             Eval(region.x, j, k5); Dot(k5, region.x, j); allBlack := allBlack & (k5 = k1);
  134.             Eval(region.x + region.w - 1, j, k5); Dot(k5, region.x + region.w - 1, j); allBlack := allBlack & (k5 = k1)
  135.         END;
  136.         IF allBlack & (region.w > 2) & (region.h > 2) THEN
  137.             IF k1 = maxIter THEN
  138.                 Display.ReplConst(Display.white, region.x + 1, region.y + 1, region.w - 2, region.h - 2, Display.replace)
  139.             ELSE
  140.                 Display.ReplConst(k1 MOD 15, region.x + 1, region.y + 1, region.w - 2, region.h - 2, Display.replace)
  141.             END
  142.         ELSIF (region.w > 2) & (region.h > 2) THEN
  143.             Divide(region.x + 1, region.y + 1, region.w - 2, region.h - 2, filler.regions);
  144.         END;
  145.         DEC(count); region := filler.regions; 
  146.         IF (filler.regions # NIL) & (count > 0) THEN filler.regions := filler.regions.next END
  147.     END;
  148.     IF region = NIL THEN Oberon.Remove(this) END
  149. END DrawMandelbrodt;
  150. PROCEDURE DragRect (filler: CrazyFiller; f: Display.Frame; x0, y0, x1, y1: INTEGER; VAR x2, y2: INTEGER;
  151.     VAR keysum: SET);
  152.     VAR keys: SET; x, y: INTEGER;
  153.     PROCEDURE ReplConst(x, y, w, h: INTEGER);
  154.     BEGIN
  155.         IF w < 0 THEN x := x + w; w := - w END;
  156.         IF h < 0 THEN y := y + h; h := - h END;
  157.         IF (w # 0) & (h # 0) THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END
  158.     END ReplConst;
  159.     PROCEDURE FlipRect(x0, y0, x1, y1, x2, y2: INTEGER);
  160.     BEGIN
  161.         ReplConst(x0 + 1, y1, x1 - x0 - 2, 1);
  162.         ReplConst(x1 - 1, y1, 1, y0 - y1);
  163.         ReplConst(x1 - 1, y0 - 1, x2 - x1, 1);
  164.         ReplConst(x2 - 1, y2, 1, y0 - y2);
  165.         ReplConst(x0 + 1, y2, x2 - x0 - 2, 1);
  166.         ReplConst(x0, y2, 1, y1 - y2)
  167.     END FlipRect;
  168. BEGIN
  169.     keys := keysum;
  170.     FlipRect(x0, y0, x0 + 1, y0 - 1, x1, y1); (* draw initial rectangle *)
  171.     WHILE keys # {} DO
  172.         Input.Mouse(keys, x, y);
  173.         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y);
  174.         keysum := keysum + keys;
  175.         x2 := Min(Max(x, f.X), f.X + f.W); (* confine x2 to frame f *)
  176.         y2 := Min(Max(y, f.Y), f.Y + f.H); (* confine y2 to frame f *)
  177.         IF y2 < SHORT(ENTIER(y0 - ABS(x2 - x0) * filler.vwr.H / filler.vwr.W + 0.5)) THEN
  178.             y2 := SHORT(ENTIER(y0 - ABS(x2 - x0) * filler.vwr.H / filler.vwr.W + 0.5))
  179.         ELSIF y2 > SHORT(ENTIER(y0 + ABS(x2 - x0) * filler.vwr.H / filler.vwr.W + 0.5)) THEN
  180.             y2 := SHORT(ENTIER(y0 + ABS(x2 - x0) * filler.vwr.H / filler.vwr.W + 0.5))
  181.         END;
  182.         IF x2 < SHORT(ENTIER(x0 - ABS(y2 - y0) * filler.vwr.W / filler.vwr. H + 0.5)) THEN
  183.             x2 := SHORT(ENTIER(x0 - ABS(y2 - y0) * filler.vwr.W / filler.vwr. H + 0.5))
  184.         ELSIF x2 > SHORT(ENTIER(x0 + ABS(y2 - y0) * filler.vwr.W / filler.vwr.H + 0.5)) THEN
  185.             x2 := SHORT(ENTIER(x0 + ABS(y2 - y0) * filler.vwr.W / filler.vwr. H + 0.5))
  186.         END;
  187.         IF (x2 # x1) OR (y2 # y1) THEN
  188.             FlipRect(x0, y0, x1, y1, x2, y2);
  189.             x1 := x2; y1 := y2
  190.         END
  191.     END;
  192.     FlipRect(x0, y0, x0 + 1, y0 - 1, x1, y1) (* erase spanned rectangle *)
  193. END DragRect;
  194. PROCEDURE InitDrawer* (VAR drawer: DrawerDesc; W, H: INTEGER; 
  195.     filler: CrazyFiller; draw: Oberon.Handler);
  196. BEGIN
  197.     drawer.handle := draw; drawer.safe := FALSE;
  198.     drawer.filler := filler;
  199.     drawer.dx := (drawer.filler.xMax - drawer.filler.xMin) / W;
  200.     drawer.dy := (drawer.filler.yMax - drawer.filler.yMin) / H;
  201. END InitDrawer;
  202. PROCEDURE InitFiller (filler: CrazyFiller; vwr: Viewers.Viewer);
  203. BEGIN
  204.     filler.xMin := -2.25; filler.xMax := 0.75; 
  205.     filler.yMin := -1.125; filler.yMax := 1.125;
  206.     filler.vwr := vwr;
  207. END InitFiller;
  208. PROCEDURE InstallCustomHandler* (h: Display.Handler);
  209.     VAR m: Viewers.ViewerMsg;
  210. BEGIN
  211.     IF h = fillerHandler THEN RETURN END;
  212.     m.id := Viewers.restore;
  213.     IF userFiller.regions # NIL THEN userFiller.regions := NIL; Oberon.Remove(userFiller.drawer) END;
  214.     userFiller.vwr.handle := h; userFiller.vwr.handle(userFiller.vwr, m);
  215.     IF systemFiller.regions # NIL THEN systemFiller.regions := NIL; Oberon.Remove(systemFiller.drawer) END;
  216.     systemFiller.vwr.handle := h; systemFiller.vwr.handle(systemFiller.vwr, m)
  217. END InstallCustomHandler;
  218. PROCEDURE DefaultHandler* (f: Display.Frame; VAR m: Display.FrameMsg);
  219. BEGIN
  220.     WITH f: Viewers.Viewer DO
  221.         IF m IS Oberon.InputMsg THEN
  222.             WITH m: Oberon.InputMsg DO
  223.                 IF m.id=Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, m.X, m.Y) END
  224.             END
  225.         ELSIF m IS Oberon.ControlMsg THEN
  226.             WITH m: Oberon.ControlMsg DO
  227.                 IF m.id=Oberon.mark THEN Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, m.X, m.Y) END
  228.             END
  229.         ELSIF m IS Viewers.ViewerMsg THEN
  230.             WITH m: Viewers.ViewerMsg DO
  231.                 IF (m.id=Viewers.restore) & (f.W > 0) & (f.H > 0) THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  232.                     Display.ReplConst(Display.black, f.X, f.Y, f.W, f.H, Display.replace)
  233.                 ELSIF (m.id=Viewers.modify) & (m.Y < f.Y) THEN Oberon.RemoveMarks(f.X, m.Y, f.W, f.Y-m.Y);
  234.                     Display.ReplConst(Display.black, f.X, m.Y, f.W, f.Y-m.Y, Display.replace)
  235.                 END
  236.             END
  237.         END
  238. END DefaultHandler;
  239. PROCEDURE CrazyHandler* (f: Display.Frame; VAR m: Display.FrameMsg);
  240.     VAR drawer: Drawer; x, y: INTEGER; filler, oldFiller: CrazyFiller; redrawMsg: Viewers.ViewerMsg;
  241.     PROCEDURE Redraw(y, h: INTEGER);
  242.         VAR region: Region;
  243.     BEGIN
  244.         IF filler.regions # NIL THEN filler.regions := NIL; Oberon.Remove(filler.drawer) END;
  245.         Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  246.         NEW(drawer); InitDrawer(drawer^, f.W, h, filler, DrawMandelbrodt);
  247.         filler.drawer := drawer;
  248.         NEW(region); region.x := f.X; region.y := y; region.w := f.W; region.h := h;
  249.         filler.regions := region;
  250.         Display.ReplConst(Display.black, f.X, y, f.W, h, Display.replace);
  251.         Oberon.Install(drawer)
  252.     END Redraw;
  253. BEGIN
  254.     WITH f: Viewers.Viewer DO
  255.         WITH m: Viewers.ViewerMsg DO
  256.             IF f.X = 0 THEN filler := userFiller ELSE filler := systemFiller END;
  257.             IF m.id = Viewers.restore THEN
  258.                 IF (f.W > 0) & (f.H > 0) THEN Redraw(f.Y, f.H)
  259.                 ELSE IF filler.regions # NIL THEN filler.regions := NIL; Oberon.Remove(filler.drawer) END
  260.                 END 
  261.             ELSIF m.id = Viewers.modify THEN Redraw(m.Y, m.H)
  262.             ELSIF m.id = Viewers.suspend THEN
  263.                 IF filler.regions # NIL THEN filler.regions := NIL; Oberon.Remove(filler.drawer) END
  264.             END
  265.         | m: Oberon.InputMsg DO
  266.             IF m.id = Oberon.track THEN (* mouse event *)
  267.                 Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, m.X, m.Y);
  268.                 IF ML IN m.keys THEN
  269.                     IF m.X < userFiller.vwr.X + userFiller.vwr.W THEN (* click in user filler *)
  270.                         filler := userFiller
  271.                     ELSE
  272.                         filler := systemFiller
  273.                     END;
  274.                     DragRect(filler, f, m.X, m.Y, m.X + 2, m.Y - 2, x, y, m.keys); (* m.X, m.Y is the upper
  275.                         left corner; x, y is the lower right corner *)
  276.                     IF m.keys # {ML, MM, MR} THEN
  277.                         NEW(oldFiller); oldFiller^ := filler^;
  278.                         filler.yMin := oldFiller.yMin + (oldFiller.yMax - oldFiller.yMin) / oldFiller.vwr.H * (Min(y, m.Y) - oldFiller.vwr.Y);
  279.                         filler.yMax := oldFiller.yMin + (oldFiller.yMax - oldFiller.yMin) / oldFiller.vwr.H * (Max(y, m.Y) - oldFiller.vwr.Y);
  280.                         filler.xMin := oldFiller.xMin + (oldFiller.xMax - oldFiller.xMin) / oldFiller.vwr.W * (Min(x, m.X) - oldFiller.vwr.X);
  281.                         filler.xMax := oldFiller.xMin + (oldFiller.xMax - oldFiller.xMin) / oldFiller.vwr.W * (Max(x, m.X) - oldFiller.vwr.X);
  282.                         redrawMsg.id := Viewers.restore;
  283.                         filler.vwr.handle(filler.vwr, redrawMsg);
  284.                     END
  285.                 END
  286.             ELSE DefaultHandler(f, m)
  287.             END
  288.         | m: Oberon.ControlMsg DO
  289.             IF m.id = Oberon.neutralize THEN
  290.                 userFiller.xMin := -2.25; userFiller.xMax := 0.75; 
  291.                 userFiller.yMin := -1.125; userFiller.yMax := 1.125;
  292.                 systemFiller.xMin := -2.25; systemFiller.xMax := 0.75; 
  293.                 systemFiller.yMin := -1.125; systemFiller.yMax := 1.125;
  294.                 redrawMsg.id := Viewers.restore;
  295.                 userFiller.vwr.handle(userFiller.vwr, redrawMsg);
  296.                 systemFiller.vwr.handle(systemFiller.vwr, redrawMsg)
  297.             ELSE DefaultHandler(f, m)
  298.             END
  299.         ELSE DefaultHandler(f, m)
  300.         END
  301. END CrazyHandler;
  302. PROCEDURE InstallDefault*;
  303.     BEGIN InstallCustomHandler(DefaultHandler) END InstallDefault;
  304. PROCEDURE InstallCrazy*;
  305.     BEGIN InstallCustomHandler(CrazyHandler) END InstallCrazy;
  306. PROCEDURE SetMaxIter*;
  307. BEGIN
  308.     In.Open; In.Int(maxIter)
  309. END SetMaxIter;
  310. PROCEDURE SetRegsPerCycle*;
  311. BEGIN
  312.     In.Open; In.Int(regsPerCycle)
  313. END SetRegsPerCycle;
  314. PROCEDURE ShowParams*;
  315. BEGIN
  316.     IF (userFiller.vwr # NIL) & (userFiller.vwr.H > 0) THEN
  317.         Out.Ln; Out.String("User filler:");
  318.         Out.Ln; Out.String("  Range:");
  319.         Out.Ln; Out.String("    xMin = "); Out.LongReal(userFiller.xMin, 20); 
  320.         Out.String(", xMax = "); Out.LongReal(userFiller.xMax, 20);
  321.         Out.Ln; Out.String("    yMin = "); Out.LongReal(userFiller.yMin, 20); 
  322.         Out.String(", yMax = "); Out.LongReal(userFiller.yMax, 20);
  323.         Out.Ln; Out.String("  Height: "); Out.Int(userFiller.vwr.H, 0);
  324.         Out.Ln; Out.String("  Width: "); Out.Int(userFiller.vwr.W, 0);
  325.         Out.Ln; Out.String("  Iterations: "); Out.Int(maxIter, 0);
  326.         Out.Ln; Out.String("  Bound: "); Out.Int(bound, 0);
  327.         Out.Ln; Out.String("  Rectangles per cycle: "); Out.Int(regsPerCycle, 0)
  328.     END;
  329.     IF (systemFiller.vwr # NIL) & (systemFiller.vwr.H > 0) THEN
  330.         Out.Ln; Out.String("System filler:");
  331.         Out.Ln; Out.String("  Range:");
  332.         Out.Ln; Out.String("    xMin = "); Out.LongReal(systemFiller.xMin, 20); 
  333.         Out.String(", xMax = "); Out.LongReal(systemFiller.xMax, 20);
  334.         Out.Ln; Out.String("    yMin = "); Out.LongReal(systemFiller.yMin, 20); 
  335.         Out.String(", yMax = "); Out.LongReal(systemFiller.yMax, 20);
  336.         Out.Ln; Out.String("  Height: "); Out.Int(systemFiller.vwr.H, 0);
  337.         Out.Ln; Out.String("  Width: "); Out.Int(systemFiller.vwr.W, 0);
  338.         Out.Ln; Out.String("  Iterations: "); Out.Int(maxIter, 0);
  339.         Out.Ln; Out.String("  Bound: "); Out.Int(bound, 0);
  340.         Out.Ln; Out.String("  Rectangles per cycle: "); Out.Int(regsPerCycle, 0)
  341. END ShowParams;
  342. PROCEDURE Init;
  343.     VAR cur: Viewers.Viewer;    
  344. BEGIN
  345.     fillerHandler := NIL; maxIter := 100; regsPerCycle := 20;
  346.     NEW(userFiller); NEW(systemFiller); 
  347.     cur := Viewers.This(0, 0); WHILE cur.state # filler DO cur := Viewers.Next(cur) END;
  348.     InitFiller(userFiller, cur);
  349.     cur := Viewers.This(cur.W, 0); WHILE cur.state # filler DO cur := Viewers.Next(cur) END;
  350.     InitFiller(systemFiller, cur)
  351. END Init;
  352. BEGIN
  353.     Init
  354. END CrazyFiller.InstallCrazy    CrazyFiller.InstallDefault    CrazyFiller.ShowParams
  355. CrazyFiller.SetMaxIter 30
  356.